(in-package :lilu-apropos)

;;;
;;; interactive apropos
;;;

(defparameter *package-options*
  '((:package-name-regex :regex "")
    (:nickname-p (member :any :yes :no) :any)
    (:location-p (member :any :yes :no) :any)))

(defclass package-iapropos (iapropos)
  ()
  (:default-initargs
   :options *package-options*
   :sorting-symbol-p nil
   :remove-duplicate-p nil
   :obj->string-fn #'package-name
   :match-object-fn #'%package-iapropos-match-package-p))

(defgeneric package-iapropos-matched-packages (package-iapropos)
  (:method  ((iapropos package-iapropos))
    (with-slots (cached-matched-objects) iapropos
      cached-matched-objects)))

(defun package-iapropos-set-option-values (iapropos &rest args
                                           &key reset-p package-name-regex nickname-p location-p)
  (declare (ignore package-name-regex nickname-p location-p))
  (apply #'iapropos-set-option-values iapropos :reset-p reset-p args))

(defmethod iapropos-update-search ((iapropos package-iapropos) changes)
  (iapropos-maching-objects iapropos
                            (list-all-packages)))

(defun %package-iapropos-match-package-p (iapropos package)
  (with-slots (cached-regexp-scanners option-values) iapropos
    (and
     package
     (when-option-regex (:package-name-regex cached-regexp-scanners)
       (cl-ppcre:scan scanner (package-name package)))
     (when-option-yes/no (:nickname-p option-values)
       (package-nicknames package))
     (when-option-yes/no (:location-p option-values)
       (package-location (make-symbol (package-name package)))))))

(defmethod iapropos-describe-object ((iapropos package-iapropos) package)
  (list :name (package-name package)
        :nicknames (package-nicknames package)
        :use-list (mapcar #'package-name (package-use-list package))
        :used-by (mapcar #'package-name (package-used-by-list package))
        :location (let ((loc (package-location (make-symbol (package-name package)))))
                    (if loc (cons :file loc) :missing))))
